home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib10.dsk / MERGE FILES.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  196 lines
  1. 10  REM  **********************
  2. 20  REM  *    MERGE FILES     *
  3. 30  REM  *   BY CHUCK KISS    *
  4. 40  REM  * COPYRIGHT (C) 1982 *
  5. 50  REM  * BY MICRO-SPARC INC *
  6. 60  REM  * LINCOLN, MA. 01773 *
  7. 70  REM  **********************
  8. 80  PRINT  CHR$(4);"NOMON C,I,O"
  9. 90  PRINT  CHR$(4);"MAXFILES 1"
  10. 100 D$ =  CHR$(4)
  11. 110  DIM T$(13),TV%(32),P$(12),TX$(24),TW%(24)
  12. 120  POKE 768,6: POKE 769,1: SPEED= 255: TEXT : HOME :FIN = 0: GOTO 250
  13. 130  HTAB 5: PRINT "     PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO QUIT      ";: POKE 35,22: RETURN 
  14. 140  VTAB 3: HTAB (20 - LEN(AA$)/2): INVERSE : PRINT AA$: NORMAL : POKE 34,4: RETURN 
  15. 150  PRINT D$"OPEN ";FILE$",L";RL
  16. 160  PRINT D$"READ ";FILE$",R";RX: INPUT REC: IF REC = 0  THEN  PRINT D$"CLOSE": GOTO 460
  17. 170  FOR R = 1 TO REC: PRINT D$"READ ";FILE$",R";R: INPUT RD$(IJ +R): NEXT R: PRINT D$"CLOSE": RETURN 
  18. 180  VTAB 15: HTAB 2: FOR K = 1 TO 36: PRINT "*";: NEXT K: PRINT : VTAB 1: HTAB 2: FOR K = 1 TO 36: PRINT "*";: NEXT K: PRINT 
  19. 190  FOR K = 2 TO 14: PRINT "*";: HTAB 38: PRINT "*": NEXT K: RETURN 
  20. 200  PRINT D$"OPEN ";FILE$ +BC$
  21. 210  PRINT D$"READ ";FILE$ +BC$
  22. 220  INPUT NF: INPUT RL: INPUT NR
  23. 230  FOR K = 1 TO NF: INPUT T$(K): INPUT TV%(K): NEXT K
  24. 240  PRINT D$"CLOSE": RETURN 
  25. 250  REM  *** MENU ***
  26. 260  REM 
  27. 270 V1 = 7:B$ = "     "
  28. 280 BC$ =  CHR$(2):G$ =  CHR$(7):H$ =  CHR$(8):V1$ =  CHR$(91):V2$ =  CHR$(93)
  29. 290  TEXT : HOME : GOSUB 180
  30. 300 AA$ = " M E R G E    F I L E S ": GOSUB 140: RESTORE 
  31. 310  VTAB 5: HTAB 3: PRINT "THIS SUBROUTINE WILL MERGE TWO (2)"
  32. 320  HTAB 4: PRINT "FILES AND ALLOW THE USER TO SORT"
  33. 330  HTAB 3: PRINT "& PRINT DATA FROM THE NEWLY MERGED"
  34. 340  HTAB 4: PRINT "FILE. NOTE THAT THIS MERGED FILE"
  35. 350  HTAB 3: PRINT "IS NOT RESIDENT WITHIN THE SYSTEM."
  36. 360  HTAB 5: PRINT "ALSO NOTE THAT ONLY COMPATIBLE"
  37. 370  HTAB 5: PRINT "FILES CAN BE MERGED: THEY ";: INVERSE : PRINT "MUST": NORMAL 
  38. 380  HTAB 3: PRINT "HAVE THE SAME # OF FIELDS AND ALSO"
  39. 390  HTAB 4: PRINT "THE SAME OVERALL RECORD LENGTH."
  40. 400  VTAB 20: HTAB 10: PRINT "HIT ";: INVERSE : PRINT " C ";: NORMAL : PRINT " FOR CATALOG  ";G$
  41. 410  PRINT : HTAB 11: PRINT "OR ";: INVERSE : PRINT "RTN";: NORMAL : PRINT " FOR EXIT ";
  42. 420  POKE  -16368,0
  43. 430  GET Y$: PRINT "": IF Y$ < > CHR$(13)  AND Y$ < >"C"  THEN 400
  44. 440  IF Y$ =  CHR$(13)  THEN  PRINT D$"RUN A.R.C."
  45. 450  PRINT "": GOTO 490
  46. 460  POKE 34,0: HOME : VTAB 5: HTAB 15: INVERSE : PRINT " N O T I C E ": NORMAL 
  47. 470  VTAB 10: HTAB (21 - LEN(FILE$)/2): PRINT FILE$: VTAB 12: HTAB 8: PRINT "HAS ONLY BEEN INITIALIZED": PRINT : HTAB 9: PRINT "AND CONTAINS NO RECORDS";G$: HTAB 22: PRINT "--": FOR D = 1 TO 2500: NEXT D
  48. 480  PRINT D$"CLOSE": RUN 
  49. 490  POKE 34,0: HOME 
  50. 500  PRINT D$"CATALOG": PRINT 
  51. 510  PRINT "ENTER ";: INVERSE : PRINT "1-ST";: NORMAL : PRINT " FILE TO MERGE :";G$;: INPUT " ";F1$: PRINT 
  52. 520  FOR D = 1 TO 250: NEXT D
  53. 530  HTAB 7: INVERSE : PRINT "2-ND";: NORMAL : PRINT " FILE TO MERGE :";G$;: INPUT " ";F2$: PRINT 
  54. 540  IF F1$ = F2$  THEN  VTAB ( PEEK(37) -1): GOTO 530
  55. 550  VTAB 23: HTAB 14: INVERSE : PRINT "S T A N D B Y": NORMAL 
  56. 560  PRINT D$"OPEN ";F1$ +BC$
  57. 570  PRINT D$"READ ";F1$ +BC$
  58. 580  INPUT N1: INPUT R1: INPUT X1
  59. 590  PRINT D$"CLOSE"
  60. 600  PRINT D$"OPEN ";F2$ +BC$
  61. 610  PRINT D$"READ ";F2$ +BC$
  62. 620  INPUT N2: INPUT R2: INPUT X2
  63. 630  PRINT D$"CLOSE"
  64. 640  IF N1 < >N2  OR R1 < >R2  THEN  HOME : VTAB 11: HTAB 5: INVERSE : PRINT "ERROR";: NORMAL : PRINT " - FILES ARE INCOMPATIBLE ";G$;G$: HTAB 8: PRINT "HIT ANY KEY TO CONTINUE ";: GET A$:: PRINT "": GOTO 490
  65. 650  PRINT D$"OPEN ";F1$
  66. 660  PRINT D$"READ ";F1$",R0": INPUT R1
  67. 670  PRINT D$"CLOSE"
  68. 680  PRINT D$"OPEN ";F2$
  69. 690  PRINT D$"READ ";F2$",R0": INPUT R2
  70. 700  PRINT D$"CLOSE"
  71. 710  DIM RD$(R1 +R2),SRT$(R1 +R2),SO%(R1 +R2)
  72. 720 FILE$ = F1$: GOSUB 200:RX = 0:IJ = 0: GOSUB 150:RT = REC
  73. 730  PRINT D$"CLOSE"
  74. 740 FILE$ = F2$:RX = 0:IJ = REC: GOSUB 150:RT = RT +REC
  75. 750  PRINT D$"CLOSE"
  76. 760  REM  ** SORT/PRINT **
  77. 770 LABEL = 0:REC = RT
  78. 780  VTAB 23: HTAB 12: PRINT "HIT ";: INVERSE : PRINT "RTN";: NORMAL : PRINT " FOR MENU"
  79. 790 B1$ = "LABEL":INDENT = 25
  80. 800  TEXT : HOME :RX = 0
  81. 810  POKE 34,0: VTAB 3: CALL  -868: FOR D = 1 TO 500: NEXT D: VTAB 3: HTAB 15: INVERSE : PRINT "MERGE FILES": POKE 34,4: NORMAL 
  82. 820  VTAB 3: INVERSE : PRINT F1$;: HTAB (40 - LEN(F2$)): PRINT F2$: NORMAL 
  83. 830 T$(NF +1) = H$ +H$ +H$ +B$: FOR K = 1 TO NF:TX$(K) =  CHR$(13): NEXT K
  84. 840  HOME :L = 0: PRINT : PRINT "  THE FOLLOWING FIELDS ARE AVAILABLE ": HTAB 6: PRINT "FOR THE MERGED FILES ";B1$;": ": PRINT 
  85. 850  FOR K = 1 TO NF  STEP 2
  86. 860  PRINT "  "; TAB( 4 -(K >9));K;". ";T$(K); TAB( 22 -((K +1) >9));K +1;". ";T$(K +1)
  87. 870  NEXT K
  88. 880 L = L +1
  89. 890  IF L >NF  THEN 970
  90. 900  VTAB 21: HTAB 10: GOSUB 130: PRINT : VTAB 17: CALL  -868: PRINT "ENTER FIELD # FOR  ";: INVERSE : PRINT "LINE ";L;G$;: NORMAL : INPUT " : ";TV$
  91. 910  IF L = 1  AND  LEN(TV$) = 0  THEN 250
  92. 920  IF  LEN(TV$) = 0  THEN 970
  93. 930  IF TV$ =  CHR$(21)  OR TV$ =  CHR$(32)  THEN 250
  94. 940  IF TV$ = "@"  THEN L = NF +1:TV = NF: FOR I = 1 TO NF:TW%(I) = I: NEXT : GOTO 970
  95. 950 TV =  INT( VAL(TV$)): IF TV <1  OR TV >NF  THEN 900
  96. 960 TW%(L) = TV: GOTO 880
  97. 970  HOME :LINES = L -1: PRINT : HTAB 8:: PRINT "YOUR ";B1$;" WILL CONSIST OF :": HTAB 7: PRINT "----------------------------"
  98. 980  FOR K = 1 TO LINES: HTAB (14 -(K >9)): PRINT K;". ";T$(TW%(K)): NEXT K
  99. 990  POKE 34,20: VTAB 22: HTAB 10: PRINT "IS THIS CORRECT (Y/N)  ";G$;: GET Y$: IF Y$ = "N"  THEN  POKE 34,4: GOTO 840
  100. 1000  IF Y$ =  CHR$(21)  OR Y$ =  CHR$(32)  THEN 470
  101. 1010  IF Y$ < >"Y"  THEN 990
  102. 1020 LC = 0
  103. 1030  VTAB 21: CALL  -868: VTAB 22: HTAB 6: PRINT "MERGE TWO OR MORE LINES (Y/N)  ";G$;: GET Y$: IF Y$ = "N"  THEN 1250
  104. 1040  IF Y$ < >"Y"  THEN 1030
  105. 1050  FOR K = 1 TO NF:TX$(K) =  CHR$(13): NEXT K
  106. 1060  GOTO 1080
  107. 1070  VTAB 21: HTAB 16: CALL  -958: HTAB 16: PRINT "TO FIELD # ": VTAB 23: HTAB 10: GOSUB 130: GOTO 1120
  108. 1080  HTAB 1: VTAB 21: CALL  -958: INVERSE : PRINT "JOIN";: NORMAL : PRINT " FIELD #";G$;: INPUT " ";LX$: IF  LEN(LX$) = 0  THEN 1250
  109. 1090  VTAB 21: HTAB 16: CALL  -958:LX =  VAL(LX$)
  110. 1100  IF LX <1  OR LX >LINES -1  THEN  INVERSE : HTAB 14: PRINT "INVALID";: NORMAL : PRINT G$;G$: FOR D = 1 TO 500: NEXT D: VTAB 21: HTAB 1: GOTO 1080
  111. 1110 LC = LC -1: GOTO 1070
  112. 1120  VTAB 21: HTAB 27: PRINT LX +1;":"
  113. 1130  VTAB 21: HTAB 32: PRINT "ENTER ";: FLASH : PRINT " ? ";G$;: VTAB 21:: HTAB 39: NORMAL :TX$(LX) = ""
  114. 1140  GET T1$: IF T1$ =  CHR$(13)  THEN TX$(LX) =  CHR$(13): GOTO 1250
  115. 1150  IF T1$ < >" "  THEN 1170
  116. 1160 TX$(LX) = TX$(LX) +T1$: GOTO 1180
  117. 1170 TX$(LX) = TX$(LX) +" " +T1$ +" "
  118. 1180 ZZ$ = T$(TW%(LX)) +T1$ +T$(TW%(LX +1))
  119. 1190 ZZ =  LEN(ZZ$) +2:ZZ = (40 -ZZ)/2 -1
  120. 1200  VTAB 23: HTAB 1: CALL  -958
  121. 1210  HTAB ZZ: INVERSE : PRINT T$(TW%(LX));: NORMAL : PRINT " ";: INVERSE : PRINT TX$(LX);: NORMAL 
  122. 1220  PRINT " ";: INVERSE : PRINT T$(TW%(LX +1)): NORMAL 
  123. 1230  FOR D = 1 TO 500: NEXT D
  124. 1240  GOTO 1080
  125. 1250  POKE 34,4: POKE 35,23: HOME : PRINT : HTAB 6: PRINT "THE ";B1$;" WILL LOOK LIKE THIS :"
  126. 1260  HTAB 6: PRINT "------------------------------"
  127. 1270  FOR K = 1 TO LINES: PRINT T$(TW%(K));TX$(K);: NEXT K
  128. 1280  VTAB 22: HTAB 14: PRINT "CORRECT (Y/N) ";G$;: GET Y$: IF Y$ = "N"  THEN 840
  129. 1290  IF Y$ < >"Y"  THEN 1280
  130. 1300  HOME : VTAB 12: HTAB 8: PRINT "WANT SORTED ";B1$;" (Y/N) ? ";G$;: GET Y1$: PRINT Y1$: IF Y1$ < >"Y"  THEN 1570
  131. 1310  HOME : PRINT : PRINT "THE FOLLOWING LINES ARE AVAILABLE FOR"
  132. 1320  PRINT "THE SORT FIELD :": PRINT 
  133. 1330  FOR K = 1 TO NF  STEP 2: HTAB (4 -(K >9)): PRINT K;". ";T$(K); TAB( 22 -(K >8));K +1;". ";T$(K +1): NEXT K: PRINT 
  134. 1340  PRINT : PRINT "SORT ON WHICH FIELD (BY NUMBER): ";G$;: INPUT " ";SF$:SF =  VAL(SF$): IF SF <1  OR SF >NF  THEN 1310
  135. 1350  POKE 34,0: POKE 35,24: HOME 
  136. 1360  VTAB 10: HTAB (13 - LEN(T$(SF))/2): PRINT "*** ";: INVERSE : PRINT "SORT ON ";T$(SF);: NORMAL : PRINT " ***"
  137. 1370  PRINT : PRINT : INVERSE : PRINT "ASCENDING";: NORMAL : PRINT " OR ";: INVERSE : PRINT "DESCENDING";: NORMAL : PRINT " SORT (A/D) : ";G$;: GET S$: PRINT S$;:S1 = (S$ = "A")
  138. 1380  IF S$ < >"A"  AND S$ < >"D"  THEN  VTAB ( PEEK(37) -1): GOTO 1370
  139. 1390 SS$ = "ASCENDING": IF S$ = "D"  THEN SS$ = "DESCENDING"
  140. 1400  VTAB 12: CALL  -958: VTAB 17: HTAB 14: PRINT "S O R T I N G"
  141. 1410  VTAB 7: HTAB 16: INVERSE : PRINT SS$;: NORMAL 
  142. 1420  FOR K = 1 TO REC
  143. 1430 SO%(K) = K
  144. 1440  IF SF = 1  THEN FL = 1: GOTO 1460
  145. 1450 FL = 0: FOR I = 1 TO SF -1:FL = FL +TV%(I): NEXT I:FL = FL +1
  146. 1460 SRT$(K) =  MID$ (RD$(K),FL,TV%(SF))
  147. 1470  NEXT K
  148. 1480 M = 1
  149. 1490 M = 3 *M +1: IF M <REC  THEN 1490
  150. 1500 M = (M -1)/3: IF M <1  THEN 1550
  151. 1510  FOR J = M +1 TO REC:LL = J -M:SS$ = SRT$(J):S = SO%(J)
  152. 1520  VTAB 20: HTAB 19: INVERSE : PRINT "   ";: HTAB (19 +(J <100) +(J <10)): PRINT J: NORMAL 
  153. 1530  IF S1 = (SRT$(LL) >SS$)  THEN SRT$(LL +M) = SRT$(LL):SO%(LL +M) = SO%(LL):LL = LL -M: IF LL >0  THEN 1530
  154. 1540 SRT$(LL +M) = SS$:SO%(LL +M) = S: NEXT J: GOTO 1500
  155. 1550  REM  SHELL SORT LIST DONE
  156. 1560  FOR D = 1 TO 1000: NEXT D
  157. 1570  IF LABEL >0  THEN 1610
  158. 1580  HOME : VTAB 9: PRINT "HOW MANY ";: INVERSE : PRINT "CARRIAGE RETURNS";: NORMAL : PRINT " FROM END OF": PRINT : HTAB 11: PRINT "ONE ";B1$;" TO NEXT ? ";G$;: INPUT " ";CR
  159. 1590  VTAB 15: HTAB 13: INVERSE : PRINT "V";: NORMAL : PRINT "IEW OR ";: INVERSE : PRINT "P";: NORMAL : PRINT "RINT ? ";G$;: GET VP$: IF VP$ < >"V"  AND VP$ < >"P"  THEN 1590
  160. 1600  PRINT VP$: FOR D = 1 TO 500: NEXT D:XX = 6
  161. 1610  GOTO 1640
  162. 1620  HOME 
  163. 1630  FOR K1 = 1 TO REC:RX = SO%(K1): GOTO 1790
  164. 1640  POKE 35,24: HOME 
  165. 1650  VTAB 23: INVERSE : PRINT "PADDLE #1";: NORMAL : PRINT " CONTROLS SCROLL/PRINT SPEED !": POKE 35,21: VTAB 6: FOR D = 1 TO 750: NEXT D
  166. 1660  IF VP$ = "P"  THEN  PRINT D$"PR#1": PRINT  CHR$(9);"80N";
  167. 1670  IF Y1$ = "Y"  THEN 1620
  168. 1680 RX = RX +1: IF RX <1  THEN RX = 1
  169. 1690  IF RX < = REC  THEN 1790
  170. 1700  PRINT D$"PR#0": PRINT : SPEED= 255: HTAB 15: INVERSE : PRINT " END OF FILE ": NORMAL : FOR D = 1 TO 1000: NEXT D
  171. 1710  IF VP$ = "P"  THEN  PRINT D$"PR#1": PRINT  CHR$(12): PRINT D$"PR#0"
  172. 1720  POKE 35,24: HOME : VTAB 9
  173. 1730  PRINT : PRINT : PRINT : POKE  -16368,0
  174. 1740  HTAB 5: PRINT "PRESS ";: INVERSE 
  175. 1745  PRINT "RETURN";: NORMAL : PRINT " TO RE-FORMAT COPY": PRINT 
  176. 1750  HTAB 7: PRINT "PRESS ";: INVERSE : PRINT " C ";: NORMAL : PRINT " FOR ANOTHER COPY ";G$;: GET Y$: PRINT 
  177. 1760  IF Y$ =  CHR$(67)  THEN  HOME :LABEL = 1:RX = XR: GOTO 1580
  178. 1770  IF Y$ =  CHR$(13)  THEN LABEL = 0:RX = XR: GOTO 800
  179. 1780  VTAB 14: GOTO 1750
  180. 1790  IF VP$ = "P"  THEN  HTAB (INDENT): IF (XX +LINES +LC) >60  THEN  PRINT  CHR$(12):XX = 6: HTAB (INDENT)
  181. 1800 FL = 0: FOR K = 1 TO NF:P$(K) =  MID$ (RD$(RX),FL +1,TV%(K)):FL = FL +TV%(K): NEXT 
  182. 1810  IF VP$ = "P"  THEN  HTAB (INDENT)
  183. 1820  FOR K = 1 TO LINES
  184. 1830 L =  LEN(P$(TW%(K))): IF L <2  THEN L = 1: GOTO 1870
  185. 1840  FOR J = 1 TO L -1
  186. 1850  IF  MID$ (P$(TW%(K)),L,1) < >" "  THEN 1870
  187. 1860 L = L -1: NEXT 
  188. 1870  PRINT  LEFT$(P$(TW%(K)),L);TX$(K);: IF TX$(K) =  CHR$(13)  THEN XX = XX +1: IF VP$ = "P"  THEN  HTAB (INDENT)
  189. 1880  SPEED=  PDL(1): NEXT K
  190. 1890  ON CR +1 GOTO 1930,1920
  191. 1900  FOR D = 1 TO CR: PRINT :XX = XX +1: NEXT D
  192. 1910  GOTO 1930
  193. 1920  PRINT :XX = XX +1
  194. 1930  IF Y1$ < >"Y"  THEN 1680
  195. 1940  NEXT K1: PRINT D$"PR#0": GOTO 1700
  196. 1950  END